perm filename ATCON.LSP[MRS,LSP]2 blob sn#659297 filedate 1982-05-13 generic text, type T, neo UTF8
(DECLARE (special PF-CONCEPTS PF-CONCEPTS-PTR
		  INDIV-CONCEPTS INDIV-CONCEPTS-PTR )

	 (DEFUN TCONC (ADDITEM PTR)
		(OR (CONSP PTR) (BREAK "TCONC - PTR not a CONS-cell!"))
		(COND ((CDR PTR)
		       (RPLACD PTR (CDR (RPLACD (CDR PTR) (NCONS ADDITEM)))) )
		      (T (RPLACD PTR (CAR (RPLACA PTR (NCONS ADDITEM))))) ) )

	 (DEFUN LCONC (ADDLIST PTR)
		(OR (CONSP PTR) (BREAK "LCONC - PTR not a CONS-cell!"))
		(COND ((NULL ADDLIST) PTR)
		      (T (COND ((CDR PTR)
				(RPLACD PTR (LAST (RPLACD (CDR PTR)
							      ADDLIST ))) )
			       (T (RPLACD PTR 
					  (LAST (CAR (RPLACA PTR 
							     ADDLIST ))) )) )) ) ) )


;; putprop  atom    value   indicator
;; defprop  atom    value   indicator
;;-------------------------------------
;;(DEFPROP PICKUP ATTRIBUTE CATEGORY)

(DEFUN PUTPROPL (ATOM IV-LIST)
   (DO ((IV-PAIRS IV-LIST (CDDR IV-PAIRS)))
       ((NULL IV-PAIRS) ATOM)
       (PUTPROP ATOM (CADR IV-PAIRS) (CAR IV-PAIRS)) ) )

(DEFMACRO DEFPROPL (ATOMS . IV-LIST)
  (COND ((ATOM ATOMS)
	   `(PROGN (PUTPROPL ',ATOMS ',IV-LIST)
		   (COND ((AND (NOT (EQ '⊃ ',ATOMS))
			       (MEMQ 'COREROLES ',IV-LIST) )
			    (TCONC ',ATOMS PF-CONCEPTS-PTR) )
			 ((MEMQ 'PROPERSORT ',IV-LIST)
			    (TCONC ',ATOMS INDIV-CONCEPTS-PTR) ) ) ) )
	(T `(PROGN (MAPC (FUNCTION (LAMBDA (A) (PUTPROPL A ',IV-LIST)))
			 ',ATOMS )
		   (COND ((AND (NOT (MEMQ '∧ ',ATOMS))
			       (MEMQ 'COREROLES ',IV-LIST) )
			    (LCONC ',ATOMS PF-CONCEPTS-PTR) )
			 ((MEMQ 'PROPERSORT ',IV-LIST)
			    (LCONC ',ATOMS INDIV-CONCEPTS-PTR) ) ) ) ) ) )

(DEFUN ADD-ROLEORDERINDEX+LT-TYPE (PFC-CONCEPTLIST)
  (MAPC #'(LAMBDA (PFC-CONCEPT)
	    (LET ((ROLEMARKLIST (APPEND (GET PFC-CONCEPT 'COREROLES)
					(MAPCAR (FUNCTION CAR)
						(GET PFC-CONCEPT 'ROLEXICON) ) )))
		 (PUTPROP PFC-CONCEPT ROLEMARKLIST 'ROLEORDERINDEX )
		 (PUTPROP PFC-CONCEPT 'SIMPLEFORM 'LT-TYPE) ) )
        PFC-CONCEPTLIST ) )

(DEFUN ADD-LT-TYPE (INDIV-CONCEPTLIST)
  (MAPC #'(LAMBDA (INDIV-CONCEPT)
	    (PUTPROP INDIV-CONCEPT 'SIMPLEFORM 'LT-TYPE) )
        INDIV-CONCEPTLIST ) )

(DEFUN IDENTIFY-ROLEMARKS (PF-CONCEPTLIST)
  (MAPC #'(LAMBDA (PF-CONCEPT)
	  (LET ((ROLEMARKLIST (APPEND (GET PF-CONCEPT 'COREROLES)
				      (MAPCAR (FUNCTION CAR)
					      (GET PF-CONCEPT 'ROLEXICON) ) )))
	       (MAPC #'(LAMBDA (ROLEMARK)
			       (PUTPROP ROLEMARK 'ROLEMARK 'CATEGORY) )
		     ROLEMARKLIST ) ) )
	PF-CONCEPTLIST ) )


(SETQ PF-CONCEPTS-PTR (NCONS NIL)
      INDIV-CONCEPTS-PTR (NCONS NIL) )

(DEFPROPL BELIEVE CATEGORY ATTRIBUTE COREROLES (AGENT PROPOBJECT)
	  ROLEXICON ((STRENGTH . TODEGREE) (REASON . BECAUSE))
	  ROLESORTS ((AGENT . PERSON) (PROPOBJECT . (↑ . AFFAIRSTATE))) )

(DEFPROPL KNOW CATEGORY ATTRIBUTE COREROLES (AGENT PROPOBJECT)
	  ROLEXICON ((JUSTIFICATION . BECAUSE))
	  ROLESORTS ((AGENT . PERSON) (PROPOBJECT . (↑ . AFFAIRSTATE))) )

(DEFPROPL KNOW-HOW CATEGORY ATTRIBUTE COREROLES (AGENT ACT-CONCEPT)
	  ROLESORTS ((AGENT . PERSON) (ACT-CONCEPT . (↑ . ACT-ATTRIBUTE))) )

(DEFPROPL WANT CATEGORY ATTRIBUTE VALUE-SORT AFFAIRSTATE COREROLES
	  (AGENT PROPOBJECT) ROLEXICON ((STRENGTH . TODEGREE) (REASON . BECAUSE))
	  ROLESORTS ((AGENT . PERSON) (PROPOBJECT ↑ . AFFAIRSTATE)) )

(DEFPROPL MEET CATEGORY ATTRIBUTE VALUE-SORT AFFAIRSTATE COREROLES
	  (MEETEE1 MEETEE2) ROLEXICON ((EVENT-TIME . ATT) (PLACE . AT))
	  ROLESORTS ((MEETEE1 . PERSON) (MEETEE2 . PERSON)
	  (EVENT-TIME . TIME) (PLACE . LOCATION)) )

(DEFPROPL PICKUP CATEGORY ACT-ATTRIBUTE COREROLES (AGENT OBJECT)
	  ROLEXICON ((ORIGIN . FROM) (PLACE . IN) (INSTRUMENT . WITH)
	  (EVENT-TIME . ATT) (GOAL . INORDERTHAT) (CONSTRAINT . WITHCARETHAT))
	  ROLESORTS ((AGENT . PHYSOB) (OBJECT . PHYSOB) (ORIGIN . PHYSOB)
	  ;; the AGENT really should be something like "SELF-ACTUATED-PHYSOB".
	  (PLACE . LOCATION) (INSTRUMENT . PHYSOB) (EVENT-TIME . TIME)
	  (GOAL . (↑ . AFFAIRSTATE)) (CONSTRAINT . (↑ . AFFAIRSTATE))) )

(DEFPROPL OWNS CATEGORY ATTRIBUTE COREROLES (POSSESSOR POSSESSION))

(DEFPROPL ASSIGNED-TO CATEGORY ATTRIBUTE COREROLES (OBJECT ASSIGNEE))

(DEFPROPL CONCEPT CATEGORY COUNT-SORT SUPERSORT PLATONIC-THING
	  COREROLES (MEMBER) ROLEXICON ((OBJECT . OF))
	  ROLESORTS ((MEMBER . (↑ . THING)) (OBJECT . THING)) )

(DEFPROPL PLATONIC-THING CATEGORY SORT SUPERSORT THING
	  COREROLES (MEMBER) ROLESORTS ((OBJECT . THING)) )

(DEFPROPL = CATEGORY ATTRIBUTE COREROLES (OBJECT OBJECT)
	    ROLESORTS ((OBJECT . THING)) )

(DEFPROPL ON CATEGORY ATTRIBUTE COREROLES (REL-OBJECT BASE-OBJECT)
	     ROLESORTS ((REL-OBJECT . PHYSOB) (BASE-OBJECT . PHYSOB)) )

(DEFPROPL AT-SAME-PLACE CATEGORY ATTRIBUTE COREROLES (OBJECT1 OBJECT2)
	  ROLEXICON ((STATE-TIME . ATT))
	  ROLESORTS ((OBJECT1 . PHYSOB) (OBJECT2 . PHYSOB) (STATE-TIME . TIME)) )

(DEFPROPL LOCATED-AT CATEGORY ATTRIBUTE COREROLES (OBJECT PLACE)
	  ROLEXICON ((STATE-TIME . ATT))
	  ROLESORTS ((OBJECT . PHYSOB) (PLACE . LOCATION) (STATE-TIME . TIME)) )

(DEFPROPL LOCATED-AT* CATEGORY ATTRIBUTE COREROLES (OBJECT PLACE)
	  ROLEXICON ((STATE-TIME . ATT))
	  ROLESORTS ((OBJECT . PHYSOB) (PLACE . LOCATION) (STATE-TIME . TIME)) )

(DEFPROPL DRIVE-PATH CATEGORY COUNT-SORT SUPERSORT THING COREROLES (MEMBER)
	  	 ROLESORTS ((MEMBER . DRIVE-PATH)) )

(DEFPROPL PAST-TIME CATEGORY COUNT-SORT SUPERSORT TIME COREROLES (MEMBER)
	  ROLESORTS ((MEMBER . TIME)) )

(DEFPROPL TIME CATEGORY SORT SUPERSORT THING COREROLES (MEMBER)
	  ROLESORTS ((MEMBER . TIME)) )

(DEFPROPL MOVE CATEGORY ACT-ATTRIBUTE VALUE-SORT AFFAIRSTATE COREROLES (AGENT OBJECT)
	       ROLESORTS ((AGENT . PHYSOB) (OBJECT . PHYSOB)) )

(DEFPROPL STRIKE CATEGORY ACT-ATTRIBUTE VALUE-SORT AFFAIRSTATE COREROLES (AGENT OBJECT)
		ROLEXICON ((INSTRUMENT . WITH)) ROLESORTS ((AGENT . PERSON)
		(OBJECT . PHYSOB) (INSTRUMENT . PHYSOB)) )

(DEFPROPL GO CATEGORY ACT-ATTRIBUTE VALUE-SORT AFFAIRSTATE COREROLES
	     (AGENT) ROLEXICON ((MODE . MODE) (ORIGIN . FROM) (TERMINUS .
	     TO) (ROUTE . VIA) (DEPARTURE-TIME . LEAVING-AT) (ARRIVAL-TIME .
	     ARRIVING-AT)) ROLESORTS ((AGENT . PERSON) (VEHICLE . VEHICLE)
	     (ORIGIN . LOCATION) (TERMINUS . LOCATION) (ROUTE . SPACE-PATH)
	     (DEPARTURE-TIME . TIME) (ARRIVAL-TIME . TIME)) )

(DEFPROPL DRIVE CATEGORY ACT-ATTRIBUTE VALUE-SORT AFFAIRSTATE COREROLES
		(AGENT VEHICLE) ROLEXICON ((ORIGIN . FROM) (TERMINUS . TO)
		(ROUTE . VIA) (DEPARTURE-TIME . LEAVING-AT) (ARRIVAL-TIME .
		ARRIVING-AT)) ROLESORTS ((AGENT . PERSON) (VEHICLE . VEHICLE)
		(ORIGIN . LOCATION) (TERMINUS . LOCATION) (ROUTE . SPACE-PATH)
		(DEPARTURE-TIME . TIME) (ARRIVAL-TIME . TIME)) )

(DEFPROPL WALK CATEGORY ACT-ATTRIBUTE VALUE-SORT AFFAIRSTATE COREROLES
	       (AGENT) ROLEXICON ((ORIGIN . FROM) (TERMINUS . TO) (ROUTE . VIA)
	       (DEPARTURE-TIME . LEAVING-AT) (ARRIVAL-TIME . ARRIVING-AT))
	       ROLESORTS ((AGENT . PERSON) (ORIGIN . LOCATION) (TERMINUS .
	       LOCATION) (ROUTE . SPACE-PATH) (DEPARTURE-TIME . TIME)
	       (ARRIVAL-TIME . TIME)) )

(DEFPROPL (↑ ↓) CATEGORY SYNTACTIC-MARKER)

(DEFPROPL (U V W X Y Z) CATEGORY VARIABLE RANGE PHYSOB)

(DEFPROPL (T T1 T2 T3) CATEGORY VARIABLE RANGE TIME)

(DEFPROPL (N M J) CATEGORY VARIABLE RANGE NUMBER)

(DEFPROPL GREATER CATEGORY ATTRIBUTE COREROLES (DOMINATOR DOMINATEE)
	  ROLESORTS ((DOMINATOR . NUMBER) (DOMINATEE . NUMBER)) )

(DEFPROPL HAMMER CATEGORY COUNT-SORT SUPERSORT TOOL COREROLES (MEMBER)
	  ROLESORTS ((MEMBER . PHYSOB)) )

(DEFPROPL TOOL CATEGORY SORT SUPERSORT PHYSOB CO-SUBSORTS (HAMMER WRENCH)
	  COREROLES (MEMBER) )

(DEFPROPL HAMMER1 PROPERSORT HAMMER)

(DEFPROPL DESK1 PROPERSORT DESK)

(DEFPROPL AUTOMOBILE1 PROPERSORT AUTOMOBILE)

(DEFPROPL MYADDRESS PROPERSORT LOCATION)

(DEFPROPL I SEMANTIC-CATEGORY INDEXICAL-TERM PROPERSORT PERSON)

(DEFPROPL YESTERDAY SEMANTIC-CATEGORY INDEXICAL-TERM PROPERSORT TIME)

(DEFPROPL (JOHN MIKE JIM PAT SALLY) PROPERSORT PERSON)

(DEFPROPL PERSON CATEGORY COUNT-SORT SUPERSORT ANIMAL COREROLES (MEMBER)
	  ROLESORTS ((MEMBER . PERSON)) )

(DEFPROPL ANIMAL CATEGORY SORT SUPERSORT LIVING-ORGANISM
	  CO-SUBSORTS (PERSON HORSE) COREROLES (MEMBER) )

(DEFPROPL LIVING-ORGANISM CATEGORY SORT SUPERSORT PHYSOB
	  CO-SUBSORTS (ANIMAL PLANT) COREROLES (MEMBER) )

(DEFPROPL DESK CATEGORY COUNT-SORT SUPERSORT FURNITURE-PIECE COREROLES (MEMBER))

(DEFPROPL FURNITURE-PIECE CATEGORY SORT SUPERSORT PHYSOB
	  CO-SUBSORTS (DESK CHAIR BED TABLE) COREROLES (MEMBER) )

(DEFPROPL AUTOMOBILE CATEGORY COUNT-SORT SUPERSORT VEHICLE COREROLES (MEMBER)
	  ROLESORTS ((MEMBER . AUTOMOBILE)) )

(DEFPROPL VEHICLE CATEGORY COUNT-SORT SUPERSORT PHYSOB COREROLES (MEMBER)
	  ROLESORTS ((MEMBER . VEHICLE)) )

(DEFPROPL NAIL CATEGORY COUNT-SORT SUPERSORT FASTENER COREROLES (MEMBER)
	  ROLESORTS ((MEMBER . PHYSOB)) )

(DEFPROPL FASTENER CATEGORY SORT SUPERSORT PHYSOB CO-SUBSORTS (NAIL SCREW STAPLE)
	  COREROLES (MEMBER) )

(DEFPROPL NUMBER CATEGORY COUNT-SORT SUPERSORT PLATONIC-THING COREROLES (MEMBER)
	  ROLESORTS ((MEMBER . NUMBER)) )

(DEFPROPL PHYSOB CATEGORY SORT SUPERSORT THING COREROLES (MEMBER)
	  	 ROLESORTS ((MEMBER . PHYSOB)) )

(DEFPROPL ACT-ATTRIBUTE CATEGORY SORT SUPERSORT ATTRIBUTE COREROLES (MEMBER)
	  	    ROLESORTS ((MEMBER . ACT-ATTRIBUTE)) )

(DEFPROPL ATTRIBUTE CATEGORY SORT SUPERSORT PLATONIC-THING COREROLES (MEMBER)
	  	    ROLESORTS ((MEMBER . ATTRIBUTE)) )

(DEFPROPL THING CATEGORY SORT COREROLES (MEMBER)
	  	 ROLESORTS ((MEMBER . THING)) )

(DEFPROPL LOCATION CATEGORY SORT SUPERSORT THING COREROLES (MEMBER)
	  	 ROLESORTS ((MEMBER . LOCATION)) )

(DEFPROPL !LOCATION CATEGORY FUNCTION VALUE-SORT LOCATION COREROLES (OBJECT)
	  ROLEXICON ((STATE-TIME . ATT))
	  ROLESORTS ((OBJECT . PHYSOB) (STATE-TIME . TIME)) )

(DEFPROPL !LOCATION* CATEGORY FUNCTION VALUE-SORT LOCATION COREROLES (OBJECT)
	  ROLEXICON ((STATE-TIME . ATT))
	  ROLESORTS ((OBJECT . PHYSOB) (STATE-TIME . TIME)) )

(DEFPROPL !INTERIOR CATEGORY FUNCTION VALUE-SORT LOCATION COREROLES (OBJECT)
	  ROLEXICON ((STATE-TIME . ATT))
	  ROLESORTS ((OBJECT . PHYSOB) (STATE-TIME . TIME)) )

(DEFPROPL !GARAGE CATEGORY FUNCTION VALUE-SORT GARAGE COREROLES (ADDRESS)
	  ROLESORTS ((ADDRESS . LOCATION)) )

(DEFPROPL !DESK CATEGORY FUNCTION VALUE-SORT DESK COREROLES (ASSOCIATE)
	  ROLESORTS ((ASSOCIATE . PERSON)) )

(DEFPROPL !OFFICE CATEGORY FUNCTION VALUE-SORT OFFICE COREROLES (ASSIGNEE)
	  ROLESORTS ((ASSIGNEE . PERSON)) )

(DEFPROPL !RIGHT-HAND CATEGORY FUNCTION VALUE-SORT HAND COREROLES (WHOLE-ANIMAL)
	  ROLESORTS ((WHOLE-ANIMAL . ANIMAL)) )

(DEFPROPL !WIFE CATEGORY FUNCTION VALUE-SORT PERSON COREROLES (SPOUSE)
	  ROLESORTS ((SPOUSE . PERSON)) )

(DEFPROPL !MOTHER CATEGORY FUNCTION VALUE-SORT PERSON COREROLES (OFFSPRING))

(DEFPROPL ⊃ COREROLES (ANTECEDENT CONSEQUENT))

(DEFPROPL (¬ ∧ ∨ ≡) COREROLES (JUNCT))

(DEFPROPL (¬ ∧ ∨ ⊃ ≡) CATEGORY CONNECTIVE VALUE-SORT AFFAIRSTATE
	  LT-TYPE SIMPLEFORM )

(DEFPROPL (∧ ∨ ≡) IDENTICAL-ROLES (JUNCT))

(DEFPROPL (∧ ∨) COREROLE-NUMBER VARIABLE)

(DEFPROPL (JUNCT ANTECEDENT CONSEQUENT) CATEGORY ROLEMARK)

(DEFPROPL (ALL EVERY ∀ SOME EXIST ∃ THE !1) CATEGORY DETERMINER)

(DEFPROPL (∀ ∃ THE !1) LT-TYPE SIMPLEFORM)

(DEFPROPL (LAMBDA λ) CATEGORY LAMBDA-DETERMINER)

(SETQ PF-CONCEPTS (CAR PF-CONCEPTS-PTR)
      INDIV-CONCEPTS (CAR INDIV-CONCEPTS-PTR) )

(ADD-ROLEORDERINDEX+LT-TYPE PF-CONCEPTS)

(ADD-LT-TYPE INDIV-CONCEPTS)

(IDENTIFY-ROLEMARKS PF-CONCEPTS)